Buscamos primero cargar todos los datos.
install.packages("plotly")
Error in install.packages : Updating loaded packages
install.packages("rgl")
Error in install.packages : Updating loaded packages
install.packages("plot3D")
Error in install.packages : Updating loaded packages
install.packages(tidyverse)
Error in install.packages : object 'tidyverse' not found
install.packages(dplyr)
Error in install.packages : object 'dplyr' not found
install.packages(GGally)
Error in install.packages : object 'GGally' not found
library("plotly")
library("plot3D")
library(tidyverse) # entorno tidy
library(dplyr) # manejo de datos
library(GGally) # scatterplots multiples
library(rgl) # para graficos 3D
df = read.csv("datos_alquiler.csv", stringsAsFactors = F)
Vemos todos los atributos de cada propiedad
colnames(df)
[1] "id" "start_date" "lat" "lon" "l1" "l2" "rooms" "surface_total"
[9] "surface_covered" "price" "currency" "property_type" "operation_type" "fondo"
table(df$property_type)
Casa Departamento PH
27 1828 90
mayor = quantile(df$surface_total, 0.99)
label = "Superficies "
hist(df$surface_total, breaks = 100, freq = F, xlab = label, xlim = c(0,mayor), main ="")
Hay un pico alrededor de 40-50m2 y luego un lento descenso de cantidad de casas con mayor superficie. Quite las 1% mas espaciosas.
variables_Interes = c("price", "rooms", "surface_total", "fondo", "lat", "lon")
labelsInteres = c("Precio", "Habitaciones", "Superficie total", "Fondo", "lat", "lon")
variables_Interes2 = c("property_type", "start_date")
par(mfrow=c(2,4))
breaksVector = c(40,20,50,35,20,20)
plot(df[,variables_Interes[5]], df[,variables_Interes[6]], xlab = "Longitud", ylab = "Latitud")
for (i in 1:length(variables_Interes)) {
#mayor = quantile(df[,variables_Interes[i]], 1, na.rm=T)
label = labelsInteres[i]
hist(df[,variables_Interes[i]], breaks = breaksVector[i], freq = F, xlab = label, main ="")
}
with(df,{
tiposProp = table(property_type)
prop.table(table(tiposProp))
barplot(tiposProp, las=2, cex.names=0.65)
})
Parece haber 3 zonas muy distintas. La mayoria de las casas tienen entre 1 y 3 habitaciones. Estamos hablando de analizar un dataset con una absoluta mayoria de departamentos en vez de casas y phs.
df$start_date = as.Date(df$start_date)
df$diaEsp = factor(weekdays(df$start_date), levels = c("lunes", "martes", "miércoles", "jueves", "viernes","sábado", "domingo"))
df$mesEsp = factor(months(df$start_date), levels= c("enero", "febrero", "marzo", "junio", "julio","agosto", "septiembre", "octubre", "noviembre", "diciembre"))
df$diaIng = factor(weekdays(df$start_date), levels = c("Monday", "Tuesday","Wednesday", "Thursday", "Friday", "Saturday","Sunday"))
df$mesIng = factor(months(df$start_date), levels= c("January", "February", "March","April","May", "June", "July","August", "September", "October", "November", "December"))
with(df,{
par(mfrow=c(1,2))
dias = table(diaEsp) #Poner diaIng o diaEsp segun corresponda
prop.table(table(dias))
barplot(dias, las=2, cex.names=0.65)
meses = table(mesEsp) #Poner mesIng o mesEsp segun corresponda
prop.table(table(meses))
barplot(meses, las=2, cex.names=0.65, )
})
ajusM1<-lm(price~1,data=df)
coe<-coef(ajusM1)
plot(df$price, xlab = "Propiedades", ylab = "Precio")
abline(h = coe[1], col='red')
abline(h = quantile(df$price, 0.95), col='blue')
#h = lm(id ~ -1, data=df)
Como la linea roja viene de un modelo con un parametro constante que no depende de ninguna variable explicativa es el promedio (con loss function suma de diferencia de cuadrados). Podemos ver que la mayoria de las propiedades (el 95%) estan concentradas por debajo de la linea azul. Mientras que el 5% de propiedades mas caras empujan el promedio (linea roja) ligeramente arriba del centro de la nube negra de propiedades. Es decir el 5% de propiedades mas caras ocupa mas de la mitad del grafico.
with(df,{
par(mfrow=c(1,3))
plot(price~surface_covered, xlab ='Superficie cubierta', ylab = 'Precio')
precioSupC<-lm(price~surface_covered,data=df)
coeSP<-coef(precioSupC)
abline(coeSP, col = 'red')
plot(price~fondo, xlab ='Fondo', ylab = 'Precio')
precioFon<-lm(price~fondo,data=df)
coeFP<-coef(precioFon)
abline(coeFP, col = 'red')
plot(price~start_date, xlab ='Fecha de pub', ylab = 'Precio')
precioFecha<-lm(price~start_date,data=df)
coeFech<-coef(precioFecha)
abline(coeFech, col = 'red')
})
A los datos me remito, es muchisimo mas clara la relacion entre superficie cubierta y precio, que precio y fondo. Ni que hablar fecha de publicacion, en el cual se ve que mi coeficiente de grado 1 es practicamente 0. Con lo cual obtenemos algo similar al promedio de fecha de publicacion.
precioSupC<-lm(price~surface_covered,data=df)
precioFecha<-lm(price~start_date,data=df)
precioFon<-lm(price~fondo,data=df)
summary(precioSupC)
Call:
lm(formula = price ~ surface_covered, data = df)
Residuals:
Min 1Q Median 3Q Max
-20670 -2470 -581 1833 40857
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5168.986 244.641 21.13 <2e-16 ***
surface_covered 231.388 4.212 54.93 <2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 4579 on 1943 degrees of freedom
Multiple R-squared: 0.6083, Adjusted R-squared: 0.6081
F-statistic: 3018 on 1 and 1943 DF, p-value: < 2.2e-16
summary(precioFon)
Call:
lm(formula = price ~ fondo, data = df)
Residuals:
Min 1Q Median 3Q Max
-18612 -4544 -1935 2543 47412
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 16544.01 181.19 91.31 <2e-16 ***
fondo 130.45 13.35 9.77 <2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 7142 on 1943 degrees of freedom
Multiple R-squared: 0.04682, Adjusted R-squared: 0.04633
F-statistic: 95.45 on 1 and 1943 DF, p-value: < 2.2e-16
summary(precioFecha)
Call:
lm(formula = price ~ start_date, data = df)
Residuals:
Min 1Q Median 3Q Max
-9575 -5049 -2136 2648 47722
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -40616.288 59867.212 -0.678 0.498
start_date 3.223 3.329 0.968 0.333
Residual standard error: 7314 on 1943 degrees of freedom
Multiple R-squared: 0.0004821, Adjusted R-squared: -3.235e-05
F-statistic: 0.9371 on 1 and 1943 DF, p-value: 0.3331
El R de cada modelo esta ordenado como el grafico. Superf cub > fondo > fecha de pub Notado que de los residuos, el mediano es siempre negativo, puedo deducir que el modelo esta prediciendo que el elemento del medio deberia ser mas grande que el que es. Esto puede deberse a la influencia de lo mucho mayor que es el precio cuando la superficie es mas grande, lo cual podria deberse a que el modelo lineal no se ajusta del todo bien por como estan distribuidos los precios en relacion a la sup.
summary(precioSupC$residuals)
Min. 1st Qu. Median Mean 3rd Qu. Max.
-20669.9 -2469.8 -581.5 0.0 1833.1 40857.2
summary(precioFon$residuals)
Min. 1st Qu. Median Mean 3rd Qu. Max.
-18612 -4544 -1935 0 2543 47412
summary(precioFecha$residuals)
Min. 1st Qu. Median Mean 3rd Qu. Max.
-9575 -5049 -2136 0 2648 47722
#sqrt(sum((precioSupC$residuals)**2))
plot(df$surface_covered, df$price, col='red', ylim = c(0 , 1.5*max(predict(precioSupC))), xlab = 'Superficie cubierta', ylab = 'Precio')
points( df$surface_covered, predict(precioSupC), col='blue')
La prediccion en azul mientras que los datos en rojo. Se puede ver como la ‘dispersion’ de los precios de superficie mas baja es menor, entonces uno puede tener una mejor prediccion, mientras que si aumenta mucho la superficie la variabilidad del precio es mayor, y el modelo le pifia mas.
desempenioHastaPorcentaje = function(porcentaje){
sup = quantile(df$surface_covered, porcentaje)
sups = df[df$surface_covered <= sup,]$surface_covered
precio = df[df$surface_covered <= sup,]$price
modelo<-lm(precio~sups,data=df)
return(summary(lm(precio~sups, data=df))$r.squared)
}
porcentajes = c(1:100)/100
plot(sapply(porcentajes, desempenioHastaPorcentaje), xlab = 'Porcentaje del dataset evaluado en modelo', ylab = 'Error del modelo en R cuadrado')
Claramente el error crece raoidamente y “de a saltos” a medida que tomo un mayor porcentaje de los datos.
par(mfrow=c(1,3))
plot(precioSupC$residuals, xlab = 'Residuos superficie cubierta', ylab = 'Residuos')
abline(h=0,col= 'red')
plot(precioFon$residuals, xlab = 'Residuos fondo', ylab = 'Residuos')
abline(h=0,col= 'red')
plot(precioFecha$residuals, xlab = 'Residuos fecha de pub', ylab = 'Residuos')
abline(h=0,col= 'red')
Tal como esperabamos, el promedio del modulo los residuos es mas chico en superifice cubierta (grafico mas comprimido en 0) mientras que va aumentando debido a mayores diferencias al 0 en los otros graficos.
modeloPrecioTiempo = lm(price~start_date, data = df)
plot(df$price~df$start_date, xlab="Fecha", ylab="Precio")
abline(coef(modeloPrecioTiempo), col='red')
No se aprecia la inflacion, es practicamente una constante.
modeloPrecioTipoPropiedad = lm(price~property_type, data = df)
boxplot(df$price~df$property_type)
coefProp = coef(modeloPrecioTipoPropiedad)
abline(modeloPrecioTipoPropiedad)
Warning in abline(modeloPrecioTipoPropiedad) :
only using the first two of 3 regression coefficients
print(coefProp)
(Intercept) property_typeDepartamento property_typePH
22981.481 -5852.160 -3103.704
Lo que este modelo nos dice es que las casas por el simple hecho de ser casas tienen un valor promedio de 22981 (que actua como una ‘base’ para el resto de las propiedades. Mientras que ser un departamento te penaliza por -5852 menos el precio relativo a una casa y ser un PH tambien te penaliza por -3103. El modelo que hice solamente conecta precio de Casa vs Departamento
zonas = kmeans(df$lat + df$lon, 3, iter.max = 50)
colores = c('red','green', 'blue')
plot(df$lat, df$lon, col=colores[zonas$cluster])
Dividimos por zona segun ubicacion, y nos fijamos que modelo ajusta mejor a cada zona particular
modelo1 = lm(price~surface_covered+rooms, data = df[zonas$cluster==1,])
modelo2 = lm(price~surface_covered+rooms, data = df[zonas$cluster==2,])
modelo3 = lm(price~surface_covered+rooms, data = df[zonas$cluster==3,])
par(mfrow=c(2,3))
plot(df[zonas$cluster==1,]$lat, df[zonas$cluster==1,]$lon, col=colores[1])
plot(df[zonas$cluster==2,]$lat, df[zonas$cluster==2,]$lon, col=colores[2])
plot(df[zonas$cluster==3,]$lat, df[zonas$cluster==3,]$lon, col=colores[3])
scatter3D(df[zonas$cluster==1,]$surface_covered, df[zonas$cluster==1,]$rooms, df[zonas$cluster==1,]$price, colvar = df[zonas$cluster==1,]$price, col = 2, add = F,xlab = 'Sup Cub', ylab= 'Hab', zlab = 'Precio')
scatter3D(df[zonas$cluster==2,]$surface_covered, df[zonas$cluster==2,]$rooms, df[zonas$cluster==2,]$price, colvar = df[zonas$cluster==2,]$price, col = 3, add = F,xlab = 'Sup Cub', ylab= 'Hab', zlab = 'Precio')
scatter3D(df[zonas$cluster==3,]$surface_covered, df[zonas$cluster==3,]$rooms, df[zonas$cluster==3,]$price, colvar = df[zonas$cluster==3,]$price, col = 4, add = F, xlab = 'Sup Cub', ylab= 'Hab', zlab = 'Precio')
#set.seed(417)
#temp <- rnorm(100, mean=30, sd=5)
#pressure <- rnorm(100)
#dtime <- 1:100
#plot_ly(x=df[zonas$cluster==1,]$surface_covered, y=df[zonas$cluster==1,]$rooms, z=df[zonas$cluster==1,]$price, type="scatter3d", mode="markers", color=0.3)
Superficie = df$surface_covered
Habitaciones = df$rooms
Precio = df$price
colores2 = c("IndianRed", "MediumPurple", "DarkOrange")
#color=colores[zonas$cluster]
fig <- plot_ly(x=~Superficie, y=~Habitaciones, z=~Precio, type="scatter3d", mode="markers", marker = list(color = colores[zonas$cluster], showscale = F),xlab = 'Sup Cub', ylab= 'Hab', zlab = 'Precio', size = 1)
fig <- fig %>% layout(title = '3 zonas distribuicion',
xaxis = list(title = 'Superficie cubierta',
zeroline = TRUE,
range = c(0, 250)),
yaxis = list(title = 'Habitaciones',
range = c(0,1400)))
fig
Warning: Ignoring 166 observations
Warning: 'scatter3d' objects don't have these attributes: 'xlab', 'ylab', 'zlab'
Valid attributes include:
'connectgaps', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'error_z', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'line', 'marker', 'meta', 'metasrc', 'mode', 'name', 'opacity', 'projection', 'scene', 'showlegend', 'stream', 'surfaceaxis', 'surfacecolor', 'text', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'visible', 'x', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'ycalendar', 'yhoverformat', 'ysrc', 'z', 'zcalendar', 'zhoverformat', 'zsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
Warning: Ignoring 166 observations
Warning: 'scatter3d' objects don't have these attributes: 'xlab', 'ylab', 'zlab'
Valid attributes include:
'connectgaps', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'error_z', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'line', 'marker', 'meta', 'metasrc', 'mode', 'name', 'opacity', 'projection', 'scene', 'showlegend', 'stream', 'surfaceaxis', 'surfacecolor', 'text', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'visible', 'x', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'ycalendar', 'yhoverformat', 'ysrc', 'z', 'zcalendar', 'zhoverformat', 'zsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
modelo1$coefficients
(Intercept) surface_covered rooms
6313.4677 216.6692 361.9120
plot3d(modelo1,size=15,col="red")
modelo2$coefficients
(Intercept) surface_covered rooms
4207.1741 189.3097 318.0363
plot3d(modelo2,size=15,col="green")
modelo3$coefficients
(Intercept) surface_covered rooms
3811.1068 237.6054 734.1301
plot3d(modelo3,size=15,col="blue")
De los coeficientes de cada modelo segun la zona podemos ver que las habitaciones suman mucho mas en una de las 3 zonas. Por otro lado hay otra zona distinta que es mas cara a ‘0 hab y 0 superficie’. En cuanto a cuanto cuesta el m2 cuadrado cubierto en cada zona es similar.
Construya una gráfica que muestre el error de ajuste en función de la cantidad de parámetros de cada modelo. Cuál modelo tiene menor error de ajuste?
modeloSimple0 = lm(price~surface_covered + fondo, data = df)
modeloSimple1 = lm(price~surface_covered +fondo, data = df)
modeloSimple2 = lm(price~surface_covered +fondo+property_type, data = df)
modeloSimple3 = lm(price~surface_covered +fondo+property_type+lat+lon, data = df)
modeloSimple4 = lm(price~surface_covered +fondo+property_type+lat+lon+start_date, data = df)
modeloCompleto = lm(price~surface_covered +fondo+property_type+lat+lon+start_date+rooms, data = df)
coefR = c(summary(modeloSimple0)$r.squared,summary(modeloSimple1)$r.squared,summary(modeloSimple2)$r.squared,summary(modeloSimple3)$r.squared,summary(modeloSimple4)$r.squared,summary(modeloCompleto)$r.squared)
plot(c(1:6), coefR, xlab = 'Modelo', ylab=' Coeficiente R cuadrado')
Podemos ver como progresa el R cuadrado cuando vamos sumando variables explicativas, notese como sumar la fecha de publicacion y habitaciones no cambia practicamente nada, ya que 4 y 5 y 6 son casi identicos. Lo mismo con 1, 2 y 3, property type y fondo no redujeron mucho el error del modelo. Esto nos dice que para minimizar el error de ajuste hay que sumar variables explicativas, pero no cualquiera, ya que en este caso la fecha fue un pesimo indicador. El quiebre se produce cuando consideramos latitud y longitud.